home *** CD-ROM | disk | FTP | other *** search
/ USGS: Oil & Gas Potential…National Wildlife Refuge / USGS - Oil & Gas Potential of the Arctic National Wildlife Refuge - Disc 2.iso / mac / MEcode / MEUnAgg.for < prev   
Text File  |  1999-02-11  |  3KB  |  236 lines
  1. c   MEUnAgg.for generates uncertainty estimates
  2.  
  3. c    at 95, 50, 5th fractiles for ANWR aggregate
  4.  
  5. c    distributions. It also creates a file that gives the sample
  6.  
  7. c    id numbers of the play runs making up the uncertainty estimates.
  8.  
  9. c
  10.  
  11. c    Written by Schuenemeyer 4/3/98
  12.  
  13. c
  14.  
  15. c    Input files:
  16.  
  17. c     Unit  8 - Aggregate distribution file name, in-place or
  18.  
  19. c               or recoverable.
  20.  
  21. c    Output files:
  22.  
  23. c     Unit 10 - Uncertainty estimates
  24.  
  25. c     Unit 11 - Sample id numbers of uncertainty estimates
  26.  
  27. c
  28.  
  29. c    Subroutines required: buble.for (included)
  30.  
  31. c
  32.  
  33.       character title*80,filein*25,rei(2)*11,filaue*25,filidu*25
  34.  
  35.       dimension x(10000,8),id(10000),nar(63,8),nfr(3)
  36.  
  37.     dimension perc(3),xs(10000)    ,fr(3,8)
  38.  
  39.     data perc/0.05,.5,.95/,rei/'In-Place   ','Recoverable'/
  40.  
  41.     data nfr/95,50,5/
  42.  
  43.     call getdat(iyrx,imonx,idayx)
  44.  
  45.     write(*,3)
  46.  
  47.     3 format(/' Program MEUnAgg.for - Uncertainty estimates for'
  48.  
  49.      1 ,' aggregate distributions'/)
  50.  
  51.     4 write(*,*)' In-place or recoverable, enter 1 or 2'
  52.  
  53.     read (*,*) ipr
  54.  
  55.     if(ipr.lt.1.or. ipr.gt.2) go to 4
  56.  
  57.     write(*,5)    rei(ipr)
  58.  
  59.     5 format(' Enter name of ',a9,' Distn file')
  60.  
  61.     read(*,'(a25)')filein
  62.  
  63.     open(8,file=filein,status='old')
  64.  
  65.     write(*,*)' Enter file name for Aggregate Uncertainty Estimates'
  66.  
  67.     read(*,'(a25)') filaue
  68.  
  69. c   This file has been called FraIPRes.dat and FraRes.dat for in-place
  70.  
  71. c    and recoverable uncertainty estimates respectively.
  72.  
  73.       open(10,file=filaue)
  74.  
  75.      write(*,9)
  76.  
  77.     9 format(' Enter file name for Aggregate Uncertainty Sample'
  78.  
  79.      1 ,' Numbers')
  80.  
  81.     read(*,'(a25)') filidu
  82.  
  83. c   This file has been called FraIPID.dat and FraID.dat for in-place
  84.  
  85. c    and recoverable uncertainty estimates respectively.
  86.  
  87.     open(11,file=filidu)
  88.  
  89. c   num=10000 is the number of simulation run
  90.  
  91.     num=10000
  92.  
  93.      nsper=10
  94.  
  95.     do i=1,8
  96.  
  97.      do j=1,3
  98.  
  99.      fr(j,i)=0.0
  100.  
  101.      end do
  102.  
  103.     end do
  104.     read(8,'(a80)')title
  105.  
  106.       do m=1,num
  107.  
  108.         read(8,*)it,(x(m,j),j=1,8)
  109.  
  110.     end do
  111.  
  112. c   do for each case    
  113.  
  114.     do ic =1,8
  115.  
  116.      do m=1,num
  117.  
  118.      xs(m)=x(m,ic)
  119.  
  120.      id(m)=m
  121.  
  122.     end do
  123.  
  124.      call buble(xs,id,num)
  125.  
  126. c   do for each percentile (fractile) loop
  127.  
  128.       do ki=1,3
  129.  
  130.       npid=int(perc(ki)*num+.001)
  131.  
  132. c   get size distribution
  133.  
  134.       nll=npid-nsper
  135.  
  136.     nul=npid+nsper
  137.  
  138.     ndif=nul-nll+1
  139.  
  140.     xndif=ndif
  141.  
  142. c   store id's  & get averages
  143.  
  144.       do i=nll,nul
  145.  
  146.      ia=(i-nll+1)+(ki-1)*ndif
  147.  
  148.      nar(ia,ic)=id(i)
  149.  
  150.      fr(ki,ic)=fr(ki,ic)+xs(i)
  151.  
  152.     end do
  153.  
  154.     end do
  155.  
  156.     do ki=1,3
  157.  
  158.      fr(ki,ic)=fr(ki,ic)/xndif
  159.  
  160.     end do
  161.  
  162.     end do
  163.  
  164.     write(10,44)
  165.  
  166.    44 format(1x,'Fractiles  TotOil   TotNAGas   1002Oil'
  167.  
  168.      1 '1002NAGas  Und1002Oil  Und1002NAGas  Def1002Oil Def1002NAGas')
  169.  
  170.     do ki=1,3
  171.  
  172.        write(10,46)nfr(ki),(fr(ki,ic),ic=1,8)
  173.  
  174.    46  format(i3,8f12.3)
  175.  
  176.     end do
  177.  
  178.     write(11,48)
  179.  
  180.    48 format(' ID Numbers of Observations-Link to Prospect-Rand.dat')
  181.  
  182.     do j=1,63
  183.  
  184.      jj=(j-1)/21 + 1
  185.  
  186.      write(11,50) j,nfr(jj),(nar(j,ic),ic=1,8)
  187.  
  188.    50  format(2i3,8i7)
  189.  
  190.     end do
  191.  
  192.     stop
  193.  
  194.       END
  195.  
  196.   
  197.  
  198.     SUBROUTINE BUBLE(X,ID,N)
  199.  
  200.       DIMENSION X(1),ID(1)
  201.  
  202.       KS=N
  203.  
  204.    15 KW=0
  205.  
  206.       DO 30 I=2,KS
  207.  
  208.       IF(X(I).GE.X(I-1)) GOTO 30
  209.  
  210.       TMP=X(I)
  211.  
  212.       X(I)=X(I-1)
  213.  
  214.       X(I-1)=TMP
  215.  
  216.       NTI=ID(I)
  217.  
  218.       ID(I)=ID(I-1)
  219.  
  220.       ID(I-1)=NTI
  221.  
  222.       KW=1
  223.  
  224.    30 CONTINUE
  225.  
  226.       IF(KW.EQ.0) RETURN
  227.  
  228.       KS=KS-1
  229.  
  230.       IF(KS.EQ.1) RETURN
  231.  
  232.       GOTO 15
  233.  
  234.       END
  235.  
  236.